home *** CD-ROM | disk | FTP | other *** search
/ PD ROM 1 / PD ROM Volume I - Macintosh Software from BMUG (1988).iso / Programming / Programming Tools / XCMDs / PioneerLVP4200.p < prev    next >
Encoding:
Text File  |  1987-08-17  |  8.6 KB  |  342 lines  |  [TEXT/ttxt]
  1. {$R-}
  2. {$D+}
  3. (*
  4.     Pioneer LVP 4200 -- a HyperCard user-defined command 
  5.     to drive a laser disc player.
  6.     ©Apple Computer, Inc. 1987
  7.     All Rights Reserved.
  8.  
  9.  
  10.     To compile and link this file using Macintosh Programmer's Workshop
  11.     (HyperXCmd.p and XCmdGlue.inc must be accessible).
  12.  
  13.     pascal -w PioneerLVP4200.p
  14.     link -m ENTRYPOINT -o HyperCommands -rt XCMD=15 -sn Main=PioneerLVP4200 ∂
  15.       PioneerLVP4200.p.o "{MPW}"Libraries:interface.o
  16.  
  17.     then use ResEdit to copy the resulting XCMD from HyperCommands
  18.     and paste it into the Home stack, or your own stack.
  19.     (XCMD=11 Panasonic, =12 Hitachi, =13 Phillips, =14 PioneerLDV6000,
  20.      =15 PioneerLVP4200)
  21. *)
  22.  
  23. {$S PioneerLVP4200 }     { Segment name must be the same as the command name. }
  24.  
  25. UNIT DummyUnit;
  26.  
  27. INTERFACE
  28.  
  29.    USES MemTypes, QuickDraw, OsIntf, HyperXCmd;
  30.     
  31. PROCEDURE EntryPoint(paramPtr: XCmdPtr);
  32.     
  33. IMPLEMENTATION
  34.  
  35. TYPE Str19 = String[19];
  36.      Str31 = String[31];
  37.  
  38. PROCEDURE PioneerLVP4200(paramPtr: XCmdPtr);                        FORWARD;
  39.  
  40.    PROCEDURE EntryPoint(paramPtr: XCmdPtr);
  41.    { entry point cannot have local procs, but forward routines can }
  42.    BEGIN
  43.      PioneerLVP4200(paramPtr);
  44.    END;
  45.  
  46.    PROCEDURE PioneerLVP4200(paramPtr: XCmdPtr);
  47.    VAR reverseFlag, offFlag, tillFlag: BOOLEAN;
  48.        tempStr: Str255;
  49.        refNum: INTEGER;
  50.        err: INTEGER;
  51.        params: ARRAY[1..32] OF Str19;
  52.  
  53.      {$I XCmdGlue.inc }
  54.       
  55.      PROCEDURE Fail(errMsg: Str255); { set theResult and quit }
  56.      BEGIN
  57.        paramPtr^.returnValue := PasToZero(errMsg);
  58.        EXIT(PioneerLVP4200);
  59.      END;
  60.             
  61.      PROCEDURE OpenSerial;
  62.      VAR handShake: SerShk;
  63.          baudRate: INTEGER;
  64.      BEGIN
  65.        baudRate := 4800;
  66.        { for now, use modem port so we don't mess with AppleTalk }
  67.        err := FSOpen('.AOUT',0,refNum);
  68.        IF err = 0 THEN 
  69.          BEGIN
  70.            WITH handShake DO
  71.              BEGIN
  72.                fXon := 1;
  73.                fCTS := 1;
  74.                xon  := CHR(17);
  75.                xoff := CHR(19);
  76.                errs := 0;
  77.                evts := 0;
  78.                fInx := 0;
  79.              END;
  80.            err := SerHShake(refNum,handShake);
  81.            IF err = 0 THEN 
  82.              err := Control(refNum,13,@baudRate);
  83.          END;
  84.      END;
  85.      
  86.      
  87.      PROCEDURE CloseSerial;
  88.      BEGIN
  89.        err := FSClose(refNum);
  90.      END;
  91.      
  92.      
  93.      PROCEDURE SendCommand(cmd: Str255);
  94.      VAR count: LongInt;
  95.      { all commands must have an extra char at end, which we smash with CR }
  96.      BEGIN
  97.        count := Length(cmd);
  98.        cmd[count] := CHAR(13);   { carriage return }
  99.        err := FSWrite(refNum, count, Pointer(Ord(@cmd)+1));
  100.      END;
  101.      
  102.      FUNCTION Concat(str1, str2, str3: Str255): Str255;
  103.      VAR result: Str255;
  104.          resultLen: INTEGER;
  105.          charNum: INTEGER;
  106.      BEGIN
  107.        result := '';
  108.        resultLen := 0;
  109.        FOR charNum := 1 TO Length(str1) DO
  110.          BEGIN
  111.            resultLen := resultLen + 1;
  112.            result[resultLen] := str1[charNum];
  113.          END;
  114.        FOR charNum := 1 TO Length(str2) DO
  115.          BEGIN
  116.            resultLen := resultLen + 1;
  117.            result[resultLen] := str2[charNum];
  118.          END;
  119.        FOR charNum := 1 TO Length(str3) DO
  120.          BEGIN
  121.            resultLen := resultLen + 1;
  122.            result[resultLen] := str3[charNum];
  123.          END;
  124.       result[0] := CHR(resultLen);
  125.       Concat := result;
  126.      END;
  127.      
  128.      
  129.      PROCEDURE GetMessage;     
  130.      VAR paramNum, charNum: INTEGER;
  131.          msgChar: CHAR;
  132.      BEGIN
  133.        { convert params to pascal strings }
  134.        FOR paramNum := 1 TO paramPtr^.paramCount DO
  135.          BEGIN
  136.            tempStr := params[paramNum];
  137.            ZeroToPas(paramPtr^.params[paramNum]^, tempStr);
  138.            { force all chars to lower case }
  139.            FOR charNum := 1 TO Length(tempStr) DO
  140.              BEGIN
  141.                msgChar := tempStr[charNum];
  142.                IF (ORD(msgChar) >= ORD('A')) AND (ORD(msgChar) <= ORD('Z')) THEN
  143.                  tempStr[charNum] := CHR(ORD('a') + (ORD(msgChar) - ORD('A')));
  144.              END;
  145.            params[paramNum] := tempStr;
  146.          END;
  147.      END;
  148.      
  149.        
  150.      FUNCTION Contains(target: Str255): BOOLEAN;
  151.      VAR offset: INTEGER;     
  152.      
  153.        FUNCTION Match(which: INTEGER): BOOLEAN;
  154.        VAR index: INTEGER;
  155.        BEGIN
  156.          Match := TRUE;
  157.          FOR index := 1 TO Length(target) DO
  158.            IF index > Length(params[which]) THEN 
  159.              BEGIN
  160.                Match := FALSE;  { ran off the end }
  161.                EXIT(Match);
  162.              END
  163.            ELSE IF target[index] <> params[which][index] THEN
  164.              BEGIN
  165.                Match := FALSE;  { hit a wrong char }
  166.                EXIT(Match);
  167.              END;
  168.        END;
  169.        
  170.      BEGIN
  171.        Contains := FALSE;
  172.        FOR offset := 1 TO paramPtr^.paramCount DO
  173.          IF Match(offset) THEN
  174.            BEGIN
  175.              Contains := TRUE;
  176.              EXIT(Contains);
  177.            END;
  178.      END;
  179.      
  180.      
  181.      FUNCTION GetDigit(digit: CHAR): Str255;
  182.      BEGIN
  183.        CASE digit OF
  184.          { doing a type conversion }
  185.          '0': GetDigit := '0';
  186.          '1': GetDigit := '1';
  187.          '2': GetDigit := '2';
  188.          '3': GetDigit := '3';
  189.          '4': GetDigit := '4';
  190.          '5': GetDigit := '5';
  191.          '6': GetDigit := '6';
  192.          '7': GetDigit := '7';
  193.          '8': GetDigit := '8';
  194.          '9': GetDigit := '9';
  195.        END;
  196.      END;
  197.   
  198.   
  199.      FUNCTION GetInteger: Str255;
  200.      { get an integer in Pioneer format }
  201.      VAR which, digitLoc, charVal: INTEGER;
  202.          intStr:            Str255;
  203.      BEGIN
  204.        intStr := '';
  205.        FOR which := 1 TO paramPtr^.paramCount DO
  206.          BEGIN
  207.            charVal := ORD(params[which][1]);
  208.            IF (charVal >= ORD('0')) AND (charVal <= ORD('9')) THEN
  209.              BEGIN
  210.                FOR digitLoc := 1 TO Length(params[which]) DO
  211.                  intStr := Concat(intStr, GetDigit(params[which][digitLoc]),'');
  212.                GetInteger := intStr;
  213.                  exit(GetInteger);
  214.              END;
  215.          END;
  216.        GetInteger := intStr;    { just in case }
  217.      END;
  218.  
  219.    BEGIN
  220.      OpenSerial;
  221.      IF err <> 0 THEN 
  222.        BEGIN
  223.          SysBeep(1);
  224.          Fail('Could not open serial port');
  225.        END;
  226.      
  227.      GetMessage;
  228.      
  229.      { set flags }
  230.      reverseFlag := Contains('rev');
  231.      offFlag := Contains('off');
  232.      tillFlag := Contains('till');
  233.      
  234.      IF Contains('stop') THEN SendCommand('ST^')
  235.      ELSE IF Contains('eject') THEN SendCommand('RJ OP^')
  236.      ELSE IF Contains('search') THEN SendCommand(Concat(GetInteger, 'SE', '^'))
  237.      ELSE IF Contains('step') THEN
  238.        BEGIN
  239.          IF NOT reverseFlag THEN SendCommand('SF^')        {step fwd}
  240.          ELSE SendCommand('SR^')                        {step rev}
  241.        END
  242.      ELSE IF Contains('play') THEN
  243.        BEGIN
  244.          IF NOT tillFlag THEN
  245.              BEGIN
  246.                 IF NOT reverseFlag THEN SendCommand('PL^')    {play fwd}
  247.                  ELSE SendCommand('60 SP MR^');                 {play rev}
  248.             END
  249.          ELSE SendCommand(Concat('FR', GetInteger, 'PL^'))    {play till}
  250.        END
  251.      ELSE IF Contains('slower') THEN
  252.        BEGIN
  253.          IF tillFlag THEN
  254.            BEGIN
  255.              IF reverseFlag THEN SendCommand(Concat('15 SP FR ', GetInteger, ' MR^'))
  256.              ELSE SendCommand(Concat('15 SP FR ', GetInteger, ' MF^'));
  257.            END
  258.          ELSE IF reverseFlag THEN SendCommand('15 SP MR^')
  259.            ELSE SendCommand('15 SP MF^')
  260.        END
  261.      ELSE IF Contains('slowest') THEN
  262.        BEGIN
  263.          IF tillFlag THEN
  264.            BEGIN
  265.              IF reverseFlag THEN SendCommand(Concat('10 SP FR ', GetInteger, ' MR^'))
  266.              ELSE SendCommand(Concat('10 SP FR ', GetInteger, ' MF^'));
  267.            END
  268.          ELSE IF reverseFlag THEN SendCommand('10 SP MR^')
  269.            ELSE SendCommand('10 SP MF^')
  270.        END
  271.      ELSE IF Contains('slow') THEN
  272.        BEGIN
  273.          IF tillFlag THEN
  274.            BEGIN
  275.              IF reverseFlag THEN SendCommand(Concat('30 SP FR ', GetInteger, ' MR^'))
  276.              ELSE SendCommand(Concat('30 SP FR ', GetInteger, ' MF^'));
  277.            END
  278.          ELSE IF reverseFlag THEN SendCommand('30 SP MR^')
  279.            ELSE SendCommand('30 SP MF^')
  280.        END
  281.      ELSE IF Contains('faster') THEN
  282.        BEGIN
  283.          IF tillFlag THEN
  284.            BEGIN
  285.              IF reverseFlag THEN SendCommand(Concat('240 SP FR ', GetInteger, ' MR^'))
  286.              ELSE SendCommand(Concat('240 SP FR ', GetInteger, ' MF^'));
  287.            END
  288.          ELSE IF reverseFlag THEN SendCommand('240 SP MR^')
  289.            ELSE SendCommand('240 SP MF^')
  290.        END
  291.      ELSE IF Contains('fast') THEN
  292.        BEGIN
  293.          IF tillFlag THEN
  294.            BEGIN
  295.              IF reverseFlag THEN SendCommand(Concat('180 SP FR ', GetInteger, ' MR^'))
  296.              ELSE SendCommand(Concat('180 SP FR ', GetInteger, ' MF^'));
  297.            END
  298.          ELSE IF reverseFlag THEN SendCommand('180 SP MR^')
  299.            ELSE SendCommand('180 SP MF^')
  300.        END
  301.      ELSE IF Contains('scan') THEN
  302.        BEGIN
  303.          IF NOT reverseFlag THEN SendCommand('NF^')        {scan fwd}
  304.          ELSE SendCommand('NR^')                        {scan rev}
  305.        END
  306.      ELSE IF Contains('picture') THEN
  307.        BEGIN
  308.          IF NOT offFlag THEN SendCommand('1VD^')            {picture on}
  309.          ELSE SendCommand('0VD^')                            {picture off}
  310.        END
  311.      ELSE IF Contains('frame') THEN
  312.        BEGIN
  313.          IF NOT offFlag THEN SendCommand('1DS^')            {frame on}
  314.          ELSE SendCommand('0DS^')                            {frame off}
  315.        END
  316.      ELSE IF Contains('sound') THEN 
  317.        BEGIN
  318.          IF Contains('1') THEN
  319.            IF NOT offFlag THEN SendCommand('1AD^')            {sound 1 on}
  320.            ELSE SendCommand('0AD^')                            {sound 1 off}
  321.          ELSE IF Contains('2') THEN
  322.            IF NOT offFlag THEN SendCommand('2AD^')            {sound 2 on}
  323.            ELSE SendCommand('0AD^')                            {sound 2 off}
  324.          ELSE
  325.             IF NOT offFlag THEN SendCommand('3AD^')            {sound stereo on}
  326.             ELSE SendCommand('0AD^');                        {sound stereo off}
  327.        END
  328.      ELSE IF Contains('init') THEN SendCommand('SA^')
  329.      ELSE
  330.         BEGIN
  331.           CloseSerial;
  332.           SysBeep(1); 
  333.           Fail('Unknown video command');
  334.         END;
  335.      CloseSerial;
  336.    END;   
  337.  
  338. END.
  339.  
  340.  
  341.  
  342.